Imports System.Drawing
Imports System.Drawing.Imaging

Public Module modPicture
    'Public Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
    'Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
    'Use bitmap.setpixel instead

#Region "ReSize Image"
    ''' <summary>
    ''' Returns a BITMAP that is zoomed (resized) according to the multiplier 'psngScale'.  The new image data is interpolated giving a fuzzy, but continuous image.
    ''' </summary>
    ''' <param name="pbmp">The Source BITMAP</param>
    ''' <param name="psngScale">The percent with which to zoom the image.  1=100%.  2 will return an image twice the size of the original, etc.</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ResizeImage(ByVal pbmp As Bitmap, ByVal psngScale As Single) As Bitmap
        Return New Bitmap(pbmp, (Convert.ToInt32(pbmp.Width * psngScale)), (Convert.ToInt32(pbmp.Height * psngScale)))
    End Function

    ''' <summary>
    ''' Returns a BITMAP that is zoomed (resized) according to the multiplier 'psngScale'.  The new image data is interpolated giving a fuzzy, but continuous image.
    ''' </summary>
    ''' <param name="pbmp">The Source BITMAP</param>
    ''' <param name="pintNewWidth">The width of the new BITMAP</param>
    ''' <param name="pintNewHeight">The height of the new BITMAP</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ResizeImage(ByVal pbmp As Bitmap, ByVal pintNewWidth As Integer, ByVal pintNewHeight As Integer) As Bitmap
        Return New Bitmap(pbmp, (Convert.ToInt32(pintNewWidth)), (Convert.ToInt32(pintNewHeight)))
    End Function

    ''' <summary>
    ''' Resizes a BITMAP such that the maximum dimension (width and height) is set by the 'pintNewMaxDimension' parameter.
    ''' If the parameter' pbolKeepAspectRatio' is true, then the height/width ratio will be maintained
    ''' </summary>
    ''' <param name="pbmp">The source BITMAP</param>
    ''' <param name="pintNewMaxDimension">The maximum dimension to apply to the BITMAP</param>
    ''' <param name="pbolKeepAspectRatio">Determines whether the height/width ratio is maintained</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ResizeImageMax(ByVal pbmp As Bitmap, ByVal pintNewMaxDimension As Integer, Optional ByVal pbolKeepAspectRatio As Boolean = True) As Bitmap
        Dim sngNewWidth As Single = pintNewMaxDimension
        Dim sngNewHeight As Single = pintNewMaxDimension

        If pbmp.Width > pbmp.Height Then
            If pbolKeepAspectRatio Then sngNewHeight *= (pbmp.Height / pbmp.Width) 'If the aspect ratio is to be maintained, modify the new height accordingly
        Else
            If pbolKeepAspectRatio Then sngNewWidth *= (pbmp.Width / pbmp.Height) 'If the aspect ratio is to be maintained, modify the new width accordingly
        End If

        Return New Bitmap(pbmp, (Convert.ToInt32(CInt(sngNewWidth))), (Convert.ToInt32(CInt(sngNewHeight))))
    End Function

    ''' <summary>
    ''' Resizes a BITMAP such that the minimum dimension (width and height) is set by the 'pintNewMaxDimension' parameter.
    ''' If the parameter' pbolKeepAspectRatio' is true, then the height/width ratio will be maintained
    ''' </summary>
    ''' <param name="pbmp">The source BITMAP</param>
    ''' <param name="pintNewMinDimension">The maximum dimension to apply to the BITMAP</param>
    ''' <param name="pbolKeepAspectRatio">Determines whether the height/width ratio is maintained</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ResizeImageMin(ByVal pbmp As Bitmap, ByVal pintNewMinDimension As Integer, Optional ByVal pbolKeepAspectRatio As Boolean = True) As Bitmap
        Dim sngNewWidth As Single = pintNewMinDimension
        Dim sngNewHeight As Single = pintNewMinDimension

        If pbmp.Width < pbmp.Height Then
            If pbolKeepAspectRatio Then sngNewHeight *= (pbmp.Height / pbmp.Width) 'If the aspect ratio is to be maintained, modify the new height accordingly
        Else
            If pbolKeepAspectRatio Then sngNewWidth *= (pbmp.Width / pbmp.Height) 'If the aspect ratio is to be maintained, modify the new width accordingly
        End If

        Return New Bitmap(pbmp, (Convert.ToInt32(CInt(sngNewWidth))), (Convert.ToInt32(CInt(sngNewHeight))))
    End Function

    ''' <summary>
    ''' Returns an image that is zoomed (resized) according to the percent 'psngZoom'.  The pixels are preserved so the returned image has no interpolation.
    ''' </summary>
    ''' <param name="psngZoom">The percent with which to zoom the image.  1=100%.  2 will return an image twice the size of the original, etc.</param>
    ''' <param name="pbmp">The source image</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ResizeImagePixelated(ByVal pbmp As Bitmap, ByVal psngZoom As Single) As Bitmap
        Dim bmpold As Bitmap = New Bitmap(pbmp.Width + 1, pbmp.Height + 1)
        'Adds an extra row and column before all pixel data
        '
        'Copies bitmap of form:
        'b11 b12 b13...b1n
        'b21 b22 b23...b2n
        'b31 b32 b33...b3n
        '... ... .........
        '... ... .........
        '... ... .........
        'b1n b2n b3n...bnn

        'to form:
        'x x   x   x  ...x  
        'x b11 b12 b13...b1n
        'x b21 b22 b23...b2n
        'x b31 b32 b33...b3n
        'x ... ... .........
        'x ... ... .........
        'x ... ... .........
        'x b1n b2n b3n...bnn
        'x=no data
        '
        'This is done because the pixelation process creates half-pixels on the first column and row.
        'Adding these extra pixels gives the pixelation process enough data to resize the entire image correctly

        For i As Integer = 0 To pbmp.Width - 1
            For j As Integer = 0 To pbmp.Height - 1
                bmpold.SetPixel(i + 1, j + 1, pbmp.GetPixel(i, j))
            Next j
        Next i

        'copy second row to top row
        For i As Integer = 1 To bmpold.Width - 1
            bmpold.SetPixel(i, 0, bmpold.GetPixel(i, 1))
        Next i

        'copy second column to first column
        For i As Integer = 1 To bmpold.Height - 1
            bmpold.SetPixel(0, i, bmpold.GetPixel(1, i))
        Next i

        'set top left corner pixel
        bmpold.SetPixel(0, 0, bmpold.GetPixel(1, 1))



        'Create the resized bitmap that will hold the zoomed image
        Dim bmpnew As Bitmap = New Bitmap((Convert.ToInt32(bmpold.Width * psngZoom)), (Convert.ToInt32(bmpold.Height * psngZoom)))

        'Create source and destination areas.  pixel data is copied from source area into the destination area and pixelated accordingly
        Dim srcRect As RectangleF = New Rectangle(0, 0, bmpold.Width, bmpold.Height)
        Dim dstRect As RectangleF = New RectangleF(-((psngZoom / 2) + 1), -((psngZoom / 2) + 1), bmpold.Width * psngZoom, bmpold.Height * psngZoom)

        Dim gfx As Graphics = Graphics.FromImage(bmpnew)    'Create a new graphics object based on the new image

        gfx.InterpolationMode = Drawing2D.InterpolationMode.NearestNeighbor 'Determines how the image is pixelated
        gfx.DrawImage(bmpold, dstRect, srcRect, GraphicsUnit.Pixel) 'Zoom the image

        Return bmpnew
    End Function
#End Region
    '!!!!
    '**************************************************
    'Copies are subset of a bitmap into another bitmap*
    '**************************************************
    Public Function ImageSubset(ByVal pbmpSource As Bitmap, ByVal prectDest As Rectangle, ByVal prectSource As Rectangle) As Bitmap
        Dim bmp As New Bitmap(prectDest.Width, prectDest.Height) 'Make a bitmap for the result.
        Dim gfx As Graphics = Graphics.FromImage(bmp) 'Make a Graphics object for the result Bitmap.
        gfx.DrawImage(pbmpSource, prectDest, prectSource, GraphicsUnit.Pixel)
        Return bmp
    End Function

    ''' <summary>
    ''' Returns the size of a BITMAP
    ''' </summary>
    ''' <param name="pbmp">The source BITMAP</param>
    ''' <paarm name="pimgFormat">The image format to use when converting the byte array to a BITMAP</paarm>
    ''' <returns></returns>
    ''' <remarks>This function is likey not very efficient given that the entire image is copied to a memory stream</remarks>
    Public Function GetImageFileSize(ByVal pbmp As Bitmap, Optional ByVal pimgFormat As Imaging.ImageFormat = Nothing) As Long
        If pimgFormat Is Nothing Then pimgFormat = Imaging.ImageFormat.Jpeg

        Dim strm = New System.IO.MemoryStream() 'Creates a temporary memory stream
        pbmp.Save(strm, pimgFormat) 'Writes all the bitmap data to temporary memory
        Return strm.Length  'Return the size of the bitmap
    End Function

    ''' <summary>
    ''' Converts a BITMAP into a serialized? array of bytes.  Returns the array of bytes.
    ''' </summary>
    ''' <param name="pbmp">The source BITMAP</param>
    ''' <paarm name="pimgFormat">The image format to use when converting the byte array to a BITMAP</paarm>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function Image2ByteArray(ByVal pbmp As Bitmap, Optional ByVal pimgFormat As Imaging.ImageFormat = Nothing) As Byte()
        If pimgFormat Is Nothing Then pimgFormat = Imaging.ImageFormat.Bmp 'Default image format

        Using stream As New System.IO.MemoryStream
            pbmp.Save(stream, pimgFormat)
            Return stream.ToArray
        End Using
    End Function

    ''' <summary>
    ''' Converts a serialized? array of bytes representing an image into a BITMAP.  Returns the image.
    ''' </summary>
    ''' <param name="abyt">The array of bytes representing the BITMAP</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ByteArray2Image(ByVal abyt As Byte()) As Bitmap
        Return Image.FromStream(New System.IO.MemoryStream(abyt, False))
    End Function

#Region "Gray Scale"
    ''' <summary>
    ''' Converts a BITMAP to gray scale.  The new gray scale BITMAP is returned.
    ''' </summary>
    ''' <param name="pbmp">The source BITMAP</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ImageToGrayScale(ByRef pbmp As Bitmap) As Bitmap
        'X & Y variables
        Dim i As Integer
        Dim j As Integer
        Dim bmpnew As Bitmap = pbmp.Clone(New Rectangle(0, 0, pbmp.Width, pbmp.Height), pbmp.PixelFormat)

        'Loop through all the pixels in the image and convert each pixel's color to gray scale
        For i = 0 To bmpnew.Width - 1
            For j = 0 To bmpnew.Height - 1
                bmpnew.SetPixel(i, j, ColortoGrayScale(bmpnew.GetPixel(i, j)))
            Next j
        Next i

        Return bmpnew
    End Function

    ''' <summary>
    ''' Converts a COLOR to gray scale.  The gray scale value is the average of the color's RGB value.
    ''' </summary>
    ''' <param name="pColor">The original COLOR</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ColortoGrayScale(ByVal pColor As Color) As Color
        Dim uintRGBSum As UInt16
        Dim uintRGBValue As UInt16

        'The below bytes must be added separately because an overflow occurs if all three are added on the same line
        'The compiler obviously attempts to add all three bytes into another byte temporary variable instead of an integer
        uintRGBSum = pColor.R
        uintRGBSum += pColor.G
        uintRGBSum += pColor.B
        uintRGBValue = uintRGBSum / 3 'Calculate the average intensity.  This is used as the gray scale value
        ColortoGrayScale = Color.FromArgb(255, uintRGBValue, uintRGBValue, uintRGBValue)   'Convert the individual RGB values back to a color value
    End Function
#End Region

#Region "Classes"
    '**********************************************
    'A class that provides easy access to 3D values
    'Any value that resides in 3D space should use this class
    '********************************************************

    ''' <summary>
    ''' A class to house 3D values.  Example are: position and x,y,z parameters (offsets, scalings, etc.).
    ''' </summary>
    ''' <remarks></remarks>
    Public Class clsPosition
        Friend csngX As Single  'X Parameter
        Friend csngY As Single  'Y Parameter
        Friend csngZ As Single  'Z Parameter

        Public Sub New(ByVal psngX As Single, ByVal psngY As Single, ByVal psngZ As Single)
            csngX = psngX
            csngY = psngY
            csngZ = psngZ
        End Sub

        Public Sub New(ByVal ppos As clsPosition)
            csngX = ppos.X
            csngY = ppos.Y
            csngZ = ppos.Z
        End Sub

#Region "Properties"
        Public ReadOnly Property X As Single
            Get
                Return csngX
            End Get
        End Property

        Public ReadOnly Property Y As Single
            Get
                Return csngY
            End Get
        End Property

        Public ReadOnly Property Z As Single
            Get
                Return csngZ
            End Get
        End Property
#End Region 'Properties

#Region "Functions"
        ''' <summary>
        ''' Calculates the distance between THIS instance of clsPosition in 3D space and the provided ppos 3D value
        ''' </summary>
        ''' <param name="ppos">The distant point from  which to calculate the distance</param>
        ''' <param name="pposScaling">Contains all the 3D scaling information to properly determine distance</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Distance_2D(ByVal ppos As clsPosition, Optional ByVal pposScaling As clsPosition = Nothing) As Single
            If pposScaling Is Nothing Then pposScaling = New clsPosition(1, 1, 1)
            Distance_2D = System.Math.Sqrt(System.Math.Pow((ppos.X - csngX) * pposScaling.X, 2) + System.Math.Pow((ppos.Y - csngY) * pposScaling.Y, 2))
        End Function

        Public Function Distance_3D(ByVal ppos As clsPosition, Optional ByVal pposScaling As clsPosition = Nothing) As Single
            If pposScaling Is Nothing Then pposScaling = New clsPosition(1, 1, 1)
            Distance_3D = System.Math.Sqrt(System.Math.Pow((ppos.X - csngX) * pposScaling.X, 2) + System.Math.Pow((ppos.Y - csngY) * pposScaling.Y, 2) + System.Math.Pow((ppos.Z - csngZ) * pposScaling.Z, 2))
        End Function

        Public Overloads Function Equals(ByVal ppos As clsPosition) As Boolean
            Return ((ppos.X = csngX) And (ppos.Y = csngY) And (ppos.Z = csngZ))
        End Function
#End Region 'Functions
    End Class
#End Region 'Classes

    Public Sub ConvertToRGB(ByVal Color As Long, ByRef R As Integer, ByRef G As Integer, ByRef B As Integer)
        R = (&HFF0000& And Color) / &H10000
        G = (&HFF00& And Color) / &H100
        B = &HFF& And Color
    End Sub

    Public Sub SaveImageAs(ByRef pbmp As Bitmap, ByVal pstrFilename As String, ByVal pintQualityLevel As Integer, pFormat As ImageFormat)
        Dim Encoder As ImageCodecInfo = GetEncoder(pFormat)
        'Create an Encoder object based on the GUID for the Quality parameter category
        Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality
        'Create an EncoderParameters object
        'An EncoderParameters object has an array of EncoderParameter objects
        'In this case, there is only one EncoderParameter object in the array
        Dim myEncoderParameters As New EncoderParameters(1)
        Dim myEncoderParameter As New EncoderParameter(myEncoder, pintQualityLevel)

        myEncoderParameters.Param(0) = myEncoderParameter
        pbmp.Save(pstrFilename, Encoder, myEncoderParameters)
    End Sub 'VaryQualityLevel

    Private Function GetEncoder(ByVal format As ImageFormat) As ImageCodecInfo
        Dim codecs As ImageCodecInfo() = ImageCodecInfo.GetImageDecoders()
        Dim codec As ImageCodecInfo

        For Each codec In codecs
            If codec.FormatID = format.Guid Then
                Return codec
            End If
        Next codec
        Return Nothing
    End Function
End Module
